home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / forms / dmoc3d / democt3d.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-03-26  |  10.4 KB  |  301 lines
  1. VERSION 2.00
  2. Begin Form Form1 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "Demo CTL3DV2.DLL"
  6.    ClientHeight    =   3495
  7.    ClientLeft      =   900
  8.    ClientTop       =   1635
  9.    ClientWidth     =   8220
  10.    ControlBox      =   0   'False
  11.    Height          =   3900
  12.    Icon            =   DEMOCT3D.FRX:0000
  13.    Left            =   840
  14.    LinkTopic       =   "Form1"
  15.    MaxButton       =   0   'False
  16.    ScaleHeight     =   3495
  17.    ScaleWidth      =   8220
  18.    Top             =   1290
  19.    Width           =   8340
  20.    Begin OptionButton Option1 
  21.       BackColor       =   &H00C0C0C0&
  22.       Caption         =   "3D Effects &Off"
  23.       FontBold        =   -1  'True
  24.       FontItalic      =   0   'False
  25.       FontName        =   "MS Sans Serif"
  26.       FontSize        =   9.75
  27.       FontStrikethru  =   0   'False
  28.       FontUnderline   =   0   'False
  29.       Height          =   255
  30.       Index           =   1
  31.       Left            =   4560
  32.       TabIndex        =   6
  33.       Top             =   120
  34.       Width           =   1800
  35.    End
  36.    Begin OptionButton Option1 
  37.       BackColor       =   &H00C0C0C0&
  38.       Caption         =   "3&D Effects On"
  39.       FontBold        =   -1  'True
  40.       FontItalic      =   0   'False
  41.       FontName        =   "MS Sans Serif"
  42.       FontSize        =   9.75
  43.       FontStrikethru  =   0   'False
  44.       FontUnderline   =   0   'False
  45.       Height          =   255
  46.       Index           =   0
  47.       Left            =   2160
  48.       TabIndex        =   5
  49.       Top             =   120
  50.       Value           =   -1  'True
  51.       Width           =   1800
  52.    End
  53.    Begin CommonDialog CMDialog1 
  54.       Left            =   7080
  55.       Top             =   0
  56.    End
  57.    Begin CommandButton Command1 
  58.       Caption         =   "&Help"
  59.       FontBold        =   -1  'True
  60.       FontItalic      =   0   'False
  61.       FontName        =   "MS Sans Serif"
  62.       FontSize        =   9.75
  63.       FontStrikethru  =   0   'False
  64.       FontUnderline   =   0   'False
  65.       Height          =   495
  66.       Index           =   3
  67.       Left            =   120
  68.       TabIndex        =   4
  69.       Top             =   2280
  70.       Width           =   7935
  71.    End
  72.    Begin CommandButton Command1 
  73.       Caption         =   "&Common Dialog"
  74.       FontBold        =   -1  'True
  75.       FontItalic      =   0   'False
  76.       FontName        =   "MS Sans Serif"
  77.       FontSize        =   9.75
  78.       FontStrikethru  =   0   'False
  79.       FontUnderline   =   0   'False
  80.       Height          =   495
  81.       Index           =   2
  82.       Left            =   120
  83.       TabIndex        =   2
  84.       Top             =   1680
  85.       Width           =   7935
  86.    End
  87.    Begin CommandButton Command1 
  88.       Cancel          =   -1  'True
  89.       Caption         =   "E&xit"
  90.       FontBold        =   -1  'True
  91.       FontItalic      =   0   'False
  92.       FontName        =   "MS Sans Serif"
  93.       FontSize        =   9.75
  94.       FontStrikethru  =   0   'False
  95.       FontUnderline   =   0   'False
  96.       Height          =   495
  97.       Index           =   4
  98.       Left            =   120
  99.       TabIndex        =   3
  100.       Top             =   2880
  101.       Width           =   7935
  102.    End
  103.    Begin CommandButton Command1 
  104.       Caption         =   "&Input Box"
  105.       FontBold        =   -1  'True
  106.       FontItalic      =   0   'False
  107.       FontName        =   "MS Sans Serif"
  108.       FontSize        =   9.75
  109.       FontStrikethru  =   0   'False
  110.       FontUnderline   =   0   'False
  111.       Height          =   495
  112.       Index           =   1
  113.       Left            =   120
  114.       TabIndex        =   1
  115.       Top             =   1080
  116.       Width           =   7935
  117.    End
  118.    Begin CommandButton Command1 
  119.       Caption         =   "&Message Box"
  120.       FontBold        =   -1  'True
  121.       FontItalic      =   0   'False
  122.       FontName        =   "MS Sans Serif"
  123.       FontSize        =   9.75
  124.       FontStrikethru  =   0   'False
  125.       FontUnderline   =   0   'False
  126.       Height          =   495
  127.       Index           =   0
  128.       Left            =   120
  129.       TabIndex        =   0
  130.       Top             =   480
  131.       Width           =   7935
  132.    End
  133. ' DemoCt3D.Frm - Demo calling Ctl3D.DLL/Ctl3DV2.DLL
  134. ' 94/08/06 Copyright 1994, Larry Rebich, The Bridge, Inc., CIS 71662,205
  135. ' 94/10/27 Clean-up and Bug in Determining if Ctl3Dv2.Dll on user's system
  136. ' 95/03/26 Use Ctl3D.DLL is Ctl3DV2 not found
  137.     Option Explicit
  138.     DefInt A-Z
  139. ' Command Indexes
  140.     Const IndexMsgBox = 0
  141.     Const IndexInputBox = 1
  142.     Const IndexCMDialog = 2
  143.     Const IndexHelp = 3
  144.     Const IndexExit = 4
  145. ' Toggle 3D Effect
  146.     Dim Is3DOn As Integer   'True if 3D on
  147. ' Option Buttons
  148.     Const IndexOption3DOn = 0
  149.     Const IndexOption3DOff = 1
  150. Sub Command1_Click (Index As Integer)
  151.     ' process samples
  152.     Select Case Index
  153.         Case IndexMsgBox
  154.             MsgBox "Sample Message", 32, "The Title"
  155.         Case IndexInputBox
  156.             Dim Inpt As String
  157.             Inpt = InputBox("Sample Message:", "The Title", "Default Value")
  158.         Case IndexCMDialog
  159.             DoCmDialog
  160.         Case IndexHelp
  161.             DoHelpMessage           'some info
  162.         Case IndexExit
  163.             Unload Me               'bye and unregister if needed
  164.     End Select
  165. End Sub
  166. Sub DoApp3D (Action)
  167. ' Toggle 3D Effect based upon the Action setting
  168.     Const SetCap = "&Set 3D "
  169.     Const SetOff = "Off"
  170.     Const SetOn = "On"
  171.     Const s3D = "3D &"
  172.     Const sStd = "Std &"
  173.     Const sMsg = "Message"
  174.     Const sInputBox = "InputBox"
  175.     Const sCommonDialog = "Command Dialog"
  176.     Const sHelpMessage = "Help Message"
  177.     If Action Then          'true
  178.         Ctl3D_Start         'start 3D effect
  179.         Is3DOn = True
  180.         Command1(IndexMsgBox).Caption = s3D & sMsg
  181.         Command1(IndexInputBox).Caption = s3D & sInputBox
  182.         Command1(IndexCMDialog).Caption = s3D & sCommonDialog
  183.         Command1(IndexHelp).Caption = s3D & sHelpMessage
  184.         BackColor = RGB(192, 192, 192)
  185.     Else                    'false
  186.         Ctl3D_End           'end 3D effect
  187.         Is3DOn = False      'set switch
  188.         Command1(IndexMsgBox).Caption = sStd & sMsg
  189.         Command1(IndexInputBox).Caption = sStd & sInputBox
  190.         Command1(IndexCMDialog).Caption = sStd & sCommonDialog
  191.         Command1(IndexHelp).Caption = sStd & sHelpMessage
  192.         BackColor = RGB(255, 255, 255)
  193.     End If
  194.     Option1(0).BackColor = BackColor
  195.     Option1(1).BackColor = BackColor
  196. End Sub
  197. Sub DoCmDialog ()
  198. ' Common File Open Dialog that does nothing
  199.     Dim Fltr As String                  'temporary filter
  200.     CmDialog1.DialogTitle = "Does Absolutely Nothing"
  201.     CmDialog1.Filename = "ctl3d.bas"
  202.     Fltr = "All (*.*)|*.*|Text (*.txt)|*.txt|"
  203.     Fltr = Fltr & "Forms (*.frm)|*.frm|"
  204.     Fltr = Fltr & "VB Projects (*.mak)|*.mak"
  205.     CmDialog1.Filter = Fltr             'file filter
  206.     CmDialog1.InitDir = App.Path        'initial path
  207.     CmDialog1.Action = 1    'open
  208. End Sub
  209. Sub DoEndingMessage ()
  210. ' Add warning message that Ctl3DV2.DLL not Installed
  211.     Dim Msg As String
  212.     Dim Ttl As String
  213.     Dim Cr As String
  214.     Cr = Chr$(13)
  215.     Msg = "Ctl3DV2.DLL was not found on your system." & Cr
  216.     Msg = Msg & "Unable to demonstrate 3D effects without it." & Cr
  217.     Msg = Msg & "Contact the author [71662,205] if you have " & Cr
  218.     Msg = Msg & "trouble finding this DLL." & Cr & Cr
  219.     Msg = Msg & "Will End Now."
  220.     Ttl = "Ctl3DV2.DLL not Found"
  221.     MsgBox Msg, 16, Ttl
  222.     End
  223. End Sub
  224. Sub DoHelpMessage ()
  225.     Dim Msg As String       'Message
  226.     Dim Ttl As String       'Title
  227.     Dim Cr As String * 1    'Carriage return
  228.     Cr = Chr$(13)
  229.     Msg = "This simple application demonstrates using Ctl3D.DLL or Ctl3DV2.DLL. "
  230.     Msg = Msg & "Ctl3DV2.DLL is used if found. Then Ctl3D.DLL. "
  231.     Msg = Msg & "The version used is shown in the form's caption." & Cr & Cr
  232.     Msg = Msg & "Click the option buttons to turn on or off "
  233.     Msg = Msg & "3D effects. "
  234.     Msg = Msg & Cr & Cr
  235.     Msg = Msg & "Click the Message, Input Box, or Common Dialog command "
  236.     Msg = Msg & "to see standard or 3D effects. "
  237.     Msg = Msg & Cr & Cr
  238.     Msg = Msg & "This demo is based upon work done by an unidentified author, CIS: 74047,2155." & Cr
  239.     Msg = Msg & "The demo was created on August 6, 1994"
  240.     Msg = Msg & " and updated on October 28,1994, "
  241.     Msg = Msg & "and March 26, 1995 "
  242.     Msg = Msg & "by Larry Rebich, CIS: 71662,205."
  243.     Ttl = "Demo Ctl3D Information"
  244.     MsgBox Msg, 64, Ttl
  245. End Sub
  246. Sub Form_Load ()
  247.     If DoesCtl3DEitherExist() Then  'test for existance of Ctl3Dv2.Dll
  248.         DoApp3D True                'set 3D effect on
  249.     Else
  250.         DoEndingMessage
  251.     End If
  252.     'setup the forms
  253.     SetupForm
  254.     'center the form
  255.     Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
  256.     DoHelpMessage
  257. End Sub
  258. Sub Form_Unload (Cancel As Integer)
  259.     ' Warning, Be Sure to end this with the Exit Button
  260.     ' or the Control Box, Close Menu Item or by using Alt-F4
  261.     If Is3DOn Then      'if 3D Effect on then turn it off
  262.         Ctl3D_End       'if not done then a GPF can occur
  263.     End If
  264. End Sub
  265. Sub Option1_Click (Index As Integer)
  266.     If Index = IndexOption3DOn Then
  267.         DoApp3D True
  268.     Else
  269.         DoApp3D False
  270.     End If
  271. End Sub
  272. Sub SetupForm ()
  273.     Dim i As Integer
  274.     Dim a As String
  275.     Dim c31h As Integer, c31l As Integer    'version numbers saved here
  276.     Dim c32h As Integer, c32l As Integer
  277.     Dim c31 As Single
  278.     Dim c32 As Single
  279.     WordToTwoIntegers VerV1, c31h, c31l     'get version numbers
  280.     WordToTwoIntegers VerV2, c32h, c32l
  281.     c31 = Val(Hex$(c31h)) + Val(Hex$(c31l)) / 100
  282.     c32 = Val(Hex$(c32h)) + Val(Hex$(c32l)) / 100
  283.     Const mm = "#0.00"
  284.     For i = IndexExit To IndexMsgBox Step -1
  285.         Command1(i).TabIndex = 0
  286.     Next
  287.     Dim ff As String, fd As Double
  288.     If DoesCtl3DExist(FileNameCtl3DV2) Then
  289.         GetFileFullNameAndDateTime FileNameCtl3DV2, ff, fd
  290.         a = Format$(c32, mm)
  291.     Else
  292.         GetFileFullNameAndDateTime FileNameCtl3DV1, ff, fd
  293.         a = Format$(c31, mm)
  294.     End If
  295.     Caption = "Using " & LCase$(ff) & ", " & a & ", " & Format$(fd, "ddddd, ttttt")
  296. End Sub
  297. Sub WordToTwoIntegers (TheWord As Integer, TheIntHigh As Integer, TheIntLow As Integer)
  298.     TheIntHigh = TheWord \ 256
  299.     TheIntLow = TheWord - (256 * TheIntHigh)
  300. End Sub
  301.